home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Cream of the Crop 22
/
Cream of the Crop 22.iso
/
program
/
ctlib100.zip
/
INSTALL.LZH
/
DISPLAY.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1996-10-12
|
10KB
|
259 lines
{**************************************************************************}
{* BitSoft Development, L.L.C. *}
{* Copyright (C) 1995, 1996 BitSoft Development, L.L.C. *}
{* All rights reserved. *}
{**************************************************************************}
unit Display;
{$X+}
interface
uses Drivers, App, Views, TextView, Objects, MsgBox,
Readers;
type
PContainerScroller = ^TContainerScroller;
TContainerScroller = object(TScroller)
Reader : PContainerReader;
destructor Done; virtual;
procedure Draw; virtual;
end; { TContainerScroller }
type
PBsdTerminal = ^TBsdTerminal;
TBsdTerminal = object(TTerminal)
constructor Init(var Bounds:TRect; AHScrollBar,
AVScrollBar: PScrollBar; ABufSize: Word);
function Valid(Command: Word): Boolean; virtual;
end; { TBsdTerminal }
type
PResultsWindow = ^TResultsWindow;
TResultsWindow = object(TWindow)
T : Text;
Terminal : PBsdTerminal;
Scroller : PContainerScroller;
constructor Init (ATitle: TTitleStr; AReader : PContainerReader);
destructor Done; virtual;
procedure SizeLimits(var Min, Max : TPoint); virtual;
function Valid(Command : Word) : Boolean; virtual;
end; { TResultsWindow }
implementation
uses Utils, Memory;
{****************************************************************************}
{** PRIVATE DECLARATIONS **}
{****************************************************************************}
const
MaxNumberOfFiles = 255;
type
FileNumbers = Set of 1..MaxNumberOfFiles;
var
FilesOpen : FileNumbers;
{****************************************************************************}
{ NewNumberAvailable }
{****************************************************************************}
function NewNumberAvailable (var NewFileNumber: Integer) : Boolean;
var
Number : Integer;
begin
NewNumberAvailable := False;
for Number := 1 to MaxNumberofFiles do
if not (Number in FilesOpen) then
begin
NewFileNumber := Number;
FilesOpen := FilesOpen + [NewFileNumber];
NewNumberAvailable := True;
Exit;
end; { if }
end; { NewNumberAvailable }
{****************************************************************************}
{** EXPORTED FUNCTIONS AND PROCEDURES **}
{****************************************************************************}
{****************************************************************************}
{ TBsdTerminal object }
{****************************************************************************}
{****************************************************************************}
{ TBsdTerminal.Init }
{****************************************************************************}
constructor TBsdTerminal.Init(var Bounds:TRect; AHScrollBar,
AVScrollBar: PScrollBar; ABufSize: Word);
begin
TTextDevice.Init(Bounds, AHScrollBar, AVScrollBar);
GrowMode := gfGrowHiX + gfGrowHiY;
BufSize := ABufSize;
if BufSize > 65520 then BufSize := 65520;
Buffer := MemAlloc(BufSize); { <-- Instead of GetMem(Buffer, BufSize) }
QueFront := 0;
QueBack := 0;
SetLimit(0,1);
SetCursor(0,0);
ShowCursor;
end;
{****************************************************************************}
{ TBsdTerminal.Valid }
{****************************************************************************}
function TBsdTerminal.Valid(Command: Word): Boolean;
begin
Valid := inherited Valid(Command) and
((Command <> cmValid) or (Buffer <> nil));
end;
{****************************************************************************}
{ TContainerScroller object }
{****************************************************************************}
{****************************************************************************}
{ TContainerScroller.Draw }
{****************************************************************************}
procedure TContainerScroller.Draw;
var
B : TDrawBuffer;
i : LongInt;
Text : string;
begin
Desktop^.Lock;
if Reader^.Container <> nil
then SetLimit(Size.X, Reader^.Container^.Count + 3)
else SetLimit(Size.X, 3);
VScrollBar^.SetStep(Size.Y - 3, 1);
MoveChar(B, ' ', GetColor(1), Size.X);
WriteLine(0, 0, Size.X, Size.Y, B);
Text := 'Count: '+Reader^.Count;
MoveStr(B, Text, GetColor(1));
WriteLine(1, 0, Length(Text), 1, B);
Text := Reader^.OtherInfo;
MoveStr(B, Text, GetColor(1));
WriteLine(1, 1, Length(Text), 1, B);
MoveChar(B, '-', GetColor(1), Size.X);
WriteLine(0, 2, Size.X, 1, B);
for i := 3 to (Size.Y - 1) do
begin
Text := Reader^.GetText(Delta.Y + (i - 3));
MoveStr(B, Text, GetColor(1));
WriteLine(1, i, Length(Text), 1, B);
end; { for }
Desktop^.UnLock;
end;
{****************************************************************************}
{ TContainerScroller.Done }
{****************************************************************************}
destructor TContainerScroller.Done;
begin
if Reader <> nil
then Dispose(Reader, Done);
TScroller.Done;
end;
{****************************************************************************}
{ TResultsWindow object }
{****************************************************************************}
{****************************************************************************}
{ TResultsWindow.Init }
{****************************************************************************}
constructor TResultsWindow.Init (ATitle: TTitleStr; AReader :
PContainerReader);
var
HScroll, VScroll : PScrollBar;
Bounds, R, Limits : TRect;
WinNumber : Integer;
begin
if not NewNumberAvailable(WinNumber)
then begin
MessageBox('Please close other windows and try again.', nil,
mfError + mfOkButton);
Fail;
end; { if }
if Desktop^.Current <> nil
then begin
Bounds.A := Desktop^.Current^.Origin;
Bounds.B.X := Bounds.A.X + Desktop^.Current^.Size.X;
Bounds.B.Y := Bounds.A.Y + Desktop^.Current^.Size.Y;
Inc(Bounds.A.X);
Inc(Bounds.A.Y);
end { if }
else Desktop^.GetExtent(Bounds);
TWindow.Init(Bounds, ATitle, WinNumber);
SizeLimits(Limits.A, Limits.B);
if ((Bounds.B.Y - Bounds.A.Y) < Limits.A.Y) or
((Bounds.B.X - Bounds.A.X) < Limits.A.X)
then begin
Desktop^.GetExtent(Bounds);
ChangeBounds(Bounds);
end; { if }
Options := Options or ofTileable;
GetExtent(Bounds);
Dec(Bounds.B.X, 15);
R.Assign(Bounds.B.X-1, Bounds.A.Y+1, Bounds.B.X, Bounds.B.Y-1);
VScroll := New(PScrollBar, Init(R));
VScroll^.Options := VScroll^.Options or ofPostProcess;
R.Assign(Bounds.A.X+2, Bounds.B.Y-1, Bounds.B.X-2, Bounds.B.Y);
HScroll := New(PScrollBar, Init(R));
HScroll^.Options := HScroll^.Options or ofPostProcess;
Insert(VScroll);
Insert(HScroll);
Bounds.Grow(-1, -1);
New(Terminal, Init(Bounds, HScroll, VScroll, 32768));
Terminal^.Options := Terminal^.Options or ofFramed;
Insert(Terminal);
AssignDevice(T, Terminal);
Rewrite(T);
GetExtent(Bounds);
Bounds.A.X := Bounds.B.X - 16;
R.Assign(Bounds.B.X-1, Bounds.A.Y+4, Bounds.B.X, Bounds.B.Y-1);
VScroll := New(PScrollBar, Init(R));
VScroll^.Options := VScroll^.Options or ofPostProcess;
R.Assign(Bounds.A.X+2, Bounds.B.Y-1, Bounds.B.X-2, Bounds.B.Y);
HScroll := New(PScrollBar, Init(R));
HScroll^.Options := HScroll^.Options or ofPostProcess;
HScroll^.GrowMode := gfGrowAll;
Insert(VScroll);
Insert(HScroll);
Bounds.Grow(-1, -1);
Scroller := New(PContainerScroller, Init(Bounds, HScroll, VScroll));
Scroller^.GrowMode := gfGrowLoX + gfGrowHiX + gfGrowHiY;
Scroller^.Reader := AReader;
Scroller^.Reader^.Owner := Scroller;
Insert(Scroller);
SelectNext(True);
end;
{****************************************************************************}
{ TResultsWindow.Done }
{****************************************************************************}
destructor TResultsWindow.Done;
begin
DisplayMessage('Freeing system resources... please wait.');
FilesOpen := FilesOpen - [Number];
TWindow.Done;
EraseMessage;
end;
{****************************************************************************}
{ TResultsWindow.Close }
{****************************************************************************}
function TResultsWindow.Valid(Command : Word) : Boolean;
begin
Valid := not TestRunning;
end;
{****************************************************************************}
{ TResultsWindow.SizeLimits }
{****************************************************************************}
procedure TResultsWindow.SizeLimits(var Min, Max : TPoint);
begin
TWindow.SizeLimits(Min, Max);
Min.X := 22;
end;
end.